Power CD/Power CD ATARI-Rechner Lieben.iso/ALLERLEI/GOBJ_112/UNITS/OSTDWNDS.PAS

Pascal/Delphi Source File | 1994-04-13 | 10.0 KB | 388 lines

{**************************************
 *  O b j e c t G E M   Version 1.12  *
 *  Copyright 1992-94 by Thomas Much  *
 **************************************
 *       Unit  O S T D W N D S        *
 **************************************
 *    Softdesign Computer Software    *
 *    Thomas Much, Gerwigstraße 46,   *
 *  76131 Karlsruhe, (0721) 62 28 41  *
 *         Thomas Much @ KA2          *
 *  [e-mail]  *
 **************************************
 *    erstellt am:        03.03.1994  *
 *    letztes Update am:  13.04.1994  *
 **************************************}

{
  WICHTIGE ANMERKUNGEN ZUM QUELLTEXT:

  ObjectGEM wird ab sofort mit dem _vollständigen_ Quelltext ausgeliefert,
  d.h. jeder kann sich die Unit selbst compilieren, womit die extrem
  lästigen Kompatibilitätsprobleme mit den PP-Releases beseitigt sind.
  ObjectGEM ist und bleibt aber trotzdem SHAREWARE, d.h. wer die Biblio-
  thek regelmäßig benutzt, muß sich REGISTRIEREN lassen (so wie bisher).
  Im Moment gibt es dafür dann "nur" die neueste Version; eine geTEXte
  Doku ist aber in Arbeit, so daß auch ein gedrucktes Handbuch immer
  wahrscheinlicher wird.

  Der Quelltext enthält z.Z. noch _keine_ Kommentare; wer sich dennoch die
  Mühe macht, ihn zu lesen, wird feststellen, daß er außerdem noch recht
  "wirr" und teilweise umständlich geschrieben ist, oder daß er evtl. auch
  unnötige Teile enthält. Das liegt daran, daß dieser Quelltext eigentlich
  gar nicht für eine Veröffentlichung gedacht war, aber immer häufiger auf-
  tretende PP-Updates haben mich schier zur Verzweiflung getrieben...
  Das alles sollte aber kein Grund sein, ObjectGEM nicht einzusetzen, denn
  sobald nach "außen" die von mir gewünschte Funktionalität erreicht ist
  (d.h. wenn alle wichtigen Objekte vorhanden sind, z.B. TEditWindow etc.),
  werde ich mich um die "innere" Optimierung kümmern (dazu gehören dann
  auch die Kommentare). Die bisher geschriebenen ObjectGEM-Anwendungen
  können dann natürlich weiterverwendet werden.

  Wer beim Durchstöbern des Textes auf vermeintliche Fehler oder verbesse-
  rungswürdige Stellen trifft (von letzterem gibt es sicherlich noch viele),
  kann mir dies gerne mitteilen - ich habe auch ich nichts gegen kostenlos
  zur Verfügung gestellte optimierte Routinen (sofern sich jemand die Mühe
  macht). Wer in anderen Projekten, die nicht in direkter Konkurrenz zu
  ObjectGEM stehen, einzelne Routinen verwenden möchte, wendet sich bitte
  an mich (ein solcher Austausch sollte kein Problem sein).

  Wer sich auf nicht dokumentierte "implementation"- oder "private"-Eigen-
  schaften verläßt, darf sich nicht über Inkompatibilitäten zu späteren
  Versionen wundern; wer meint, eine Dokumentationslücke entdeckt zu haben
  (außer dem "Abgrund" des noch fehlenden Handbuchs...), kann mir dies
  gerne mitteilen.

  WICHTIG: Wer den Quelltext verändert und dann Probleme beim Compilieren,
  Ausführen o.ä. hat, kann nicht damit rechnen, daß ich den Fehler suche;
  tritt der Fehler allerdings auch mit dem Original-Quelltext auf, würde
  ich mich über eine genaue Fehlerbeschreibung freuen. Veränderte Quell-
  texte dürfen _nicht_ weitergegeben werden, dies wäre ein Verstoß gegen
  das Copyright!

  Kleine Info zum Schluß: Als "default tabsize" verwende ich 2. Wer drei
  Punkte ("...") im Quelltext entdeckt, hat eine Stelle gefunden, an der
  ich z.Z. arbeite ;-)

  "Möge die OOP mit Euch sein!"
}


{$IFDEF DEBUG}
    {$B+,D+,G-,I-,L+,N-,P-,Q+,R+,S+,T-,V-,X+,Z+}
{$ELSE}
    {$B+,D-,G-,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X+,Z+}
{$ENDIF}

unit OStdWnds;

interface

uses

    Strings,Gem,Objects,OTypes,OProcs,OWindows;

type

    PTextWindow = ^TTextWindow;
    TTextWindow = object(TWindow)
        public
        Lines   : PStrCollection;
        FontID,
        FontSize,
        Color   : integer;
        constructor Init(AParent: PWindow; ATitle: string; InitLines,ADelta: integer);
        destructor Done; virtual;
        function GetStyle: integer; virtual;
        function GetScroller: PScroller; virtual;
        function GetClassName: string; virtual;
        procedure InitPaint; virtual;
        procedure Paint(var PaintInfo: TPaintStruct); virtual;
        procedure ExitPaint; virtual;
        procedure WMClosed; virtual;
        procedure AddLine(NewLine: string); virtual;
        procedure InsertLine(Index: longint; NewLine: string); virtual;
        procedure DeleteLine(LineNumber: integer); virtual;
        function GetLine(LineNumber: integer): string; virtual;
        function GetLineLength(LineNumber: integer): integer; virtual;
        function GetNumLines: integer; virtual;
        procedure SetFont(NewID,NewSize: integer); virtual;
        procedure UpdateSubTitle; virtual;
        private
        attrib: ARRAY_10;
        fcw,
        fch,
        tfx   : integer
    end;

    PEditWindow = ^TEditWindow;
    TEditWindow = object(TTextWindow)
        public
        { ... }
        function GetClassName: string; virtual;
    end;

    PFileWindow = ^TFileWindow;
    TFileWindow = object(TEditWindow)
        public
        { ... }
        function GetClassName: string; virtual;
    end;

    PHelpWindow = ^THelpWindow;
    THelpWindow = object(TFileWindow)
        public
        { ... }
        function GetClassName: string; virtual;
    end;



implementation


{ *** Objekt TTEXTWINDOW *** }

constructor TTextWindow.Init(AParent: PWindow; ATitle: string; InitLines,ADelta: integer);

    begin
        if not(inherited Init(AParent,ATitle)) then fail;
        if Scroller=nil then
            begin
                inherited Done;
                fail
            end;
        new(Lines,Init(InitLines,ADelta));
        if Lines=nil then
            begin
                inherited Done;
                fail
            end;
        UpdateSubTitle
    end;


destructor TTextWindow.Done;

    begin
        if Lines<>nil then dispose(Lines,Done);
        inherited Done
    end;


function TTextWindow.GetStyle: integer;

    begin
        GetStyle:=(inherited GetStyle and not(INFO)) or SLIDER
    end;


function TTextWindow.GetScroller: PScroller;
    var dummy: string[33];

    begin
        GetScroller:=new(PScroller,Init(@self,1,1,1,1));
        if Scroller<>nil then SetFont(vqt_name(vdiHandle,1,dummy),10);
        Color:=Black
    end;


function TTextWindow.GetClassName: string;

    begin
        GetClassName:='TextWindow'
    end;


procedure TTextWindow.InitPaint;
    var dummy: integer;

    begin
        vqt_attributes(vdiHandle,attrib);
        tfx:=GP.teffects;
        gem.vst_font(vdiHandle,FontID);
        gem.vst_point(vdiHandle,FontSize,dummy,dummy,dummy,dummy);
        gem.vst_alignment(vdiHandle,TA_LEFT,TA_TOP,dummy,dummy);
        gem.vst_color(vdiHandle,Color);
        gem.vst_rotation(vdiHandle,0);
        gem.vst_effects(vdiHandle,TF_NORMAL);
        gem.vswr_mode(vdiHandle,MD_REPLACE)
    end;


procedure TTextWindow.Paint(var PaintInfo: TPaintStruct);
    var q: longint;

    begin
        if Lines^.Count>0 then
            for q:=0 to pred(Lines^.Count) do
                v_gtext(vdiHandle,Scroller^.GetXOrg,Scroller^.GetYOrg+q*fch,StrPas(Lines^.At(q)))
        { ... }
    end;


procedure TTextWindow.ExitPaint;
    var dummy: integer;

    begin
        gem.vst_font(vdiHandle,attrib[0]);
        gem.vst_height(vdiHandle,attrib[7],dummy,dummy,dummy,dummy);
        gem.vst_alignment(vdiHandle,attrib[3],attrib[4],dummy,dummy);
        gem.vst_color(vdiHandle,attrib[1]);
        gem.vst_rotation(vdiHandle,attrib[2]);
         gem.vst_effects(vdiHandle,tfx);
        gem.vswr_mode(vdiHandle,attrib[5])
    end;


procedure TTextWindow.WMClosed;

    begin
        if CanClose then Destroy
    end;


procedure TTextWindow.AddLine(NewLine: string);
    var xr: integer;

    begin
        Lines^.AtInsert(Lines^.Count,ChrNew(NewLine));
        { ... }
        UpdateSubTitle;
        if length(NewLine)>=Scroller^.XRange then xr:=length(NewLine)+1
        else
            xr:=Scroller^.XRange;
        Scroller^.SetRange(xr,Scroller^.YRange+1);
        Scroller^.ScrollTo(0,Lines^.Count);
        ForceRedraw
    end;


procedure TTextWindow.InsertLine(Index: longint; NewLine: string);
    var xr: integer;

    begin
        if Index<0 then Index:=0;
        if Index>Lines^.Count then Index:=Lines^.Count;
        Lines^.AtInsert(Index,ChrNew(NewLine));
        { ... }
        UpdateSubTitle;
        if length(NewLine)>=Scroller^.XRange then xr:=length(NewLine)+1
        else
            xr:=Scroller^.XRange;
        Scroller^.SetRange(xr,Scroller^.YRange+1);
        Scroller^.ScrollTo(0,Index);
        ForceRedraw
    end;


procedure TTextWindow.DeleteLine(LineNumber: integer);

    begin
        if (LineNumber>=0) and (LineNumber<Lines^.Count) then Lines^.AtFree(LineNumber);
        { ... }
        UpdateSubTitle;
        Scroller^.SetRange(Scroller^.XRange,Scroller^.YRange-1);
        ForceRedraw
    end;


function TTextWindow.GetLine(LineNumber: integer): string;
    var p: PChar;

    begin
        GetLine:='';
        if (LineNumber>=0) and (LineNumber<Lines^.Count) then
            begin
                p:=Lines^.At(LineNumber);
                if p<>nil then GetLine:=StrPas(p)
            end
    end;


function TTextWindow.GetLineLength(LineNumber: integer): integer;

    begin
        GetLineLength:=length(GetLine(LineNumber))
    end;


function TTextWindow.GetNumLines: integer;

    begin
        GetNumLines:=Lines^.Count
    end;


procedure TTextWindow.SetFont(NewID,NewSize: integer);
    var dummy: integer;
        atrb : ARRAY_10;

    begin
        vqt_attributes(vdiHandle,atrb);
        FontID:=gem.vst_font(vdiHandle,NewID);
        FontSize:=gem.vst_point(vdiHandle,NewSize,dummy,dummy,fcw,fch);
        gem.vst_font(vdiHandle,atrb[0]);
        gem.vst_height(vdiHandle,atrb[7],dummy,dummy,dummy,dummy);
        Scroller^.SetUnits(fcw,fch)
    end;


procedure TTextWindow.UpdateSubTitle;
    var n: longint;

    begin
        n:=GetNumLines;
        if Application^.Attr.Country in [FRG,SWG] then
            begin
                if n=1 then SetSubTitle(' 1 Zeile')
                else
                    SetSubTitle(' '+ltoa(n)+' Zeilen')
            end
        else
            begin
                if n=1 then SetSubTitle(' 1 line')
                else
                    SetSubTitle(' '+ltoa(n)+' lines')
            end
    end;

{ *** TTEXTWINDOW *** }



{ *** Objekt TEDITWINDOW *** }

function TEditWindow.GetClassName: string;

    begin
        GetClassName:='EditWindow'
    end;

{ *** TEDITWINDOW *** }



{ *** Objekt TEDITWINDOW *** }

function TFileWindow.GetClassName: string;

    begin
        GetClassName:='FileWindow'
    end;

{ *** TEDITWINDOW *** }



{ *** Objekt THELPWINDOW *** }

function THelpWindow.GetClassName: string;

    begin
        GetClassName:='HelpWindow'
    end;

{ *** THELPWINDOW *** }

end.